home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xlisp20 / xlisp_h / xlisp.h < prev   
Text File  |  1990-02-03  |  9KB  |  339 lines
  1. /* xlisp - a small subset of lisp */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. /* system specific definitions */
  7. #define ATARI
  8.  
  9. #include <stdio.h>
  10. #include <ctype.h>
  11. #ifndef MEGAMAX
  12. #include <setjmp.h>
  13. #endif
  14.  
  15. /* NNODES    number of nodes to allocate in each request (200) */
  16. /* TDEPTH    trace stack depth (100) */
  17. /* FORWARD    type of a forward declaration () */
  18. /* LOCAL    type of a local function (static) */
  19. /* AFMT        printf format for addresses ("%x") */
  20. /* FIXNUM    data type for fixed point numbers (long) */
  21. /* ITYPE    return type for fixed point conversion routine (long) */
  22. /* ICNV        fixed point input conversion routine (atol) */
  23. /* IFMT        printf format for fixed point numbers ("%ld") */
  24. /* FLONUM    data type for floating point numbers (float) */
  25. /* FTYPE    return type for floating point conversion routine (double) */
  26. /* FCNV        floating point input conversion routine (atof) */
  27. /* FFMT        printf format for floating point numbers ("%f") */
  28.  
  29. /* for the Computer Innovations compiler */
  30. #ifdef CI
  31. #define NNODES        1000
  32. #define TDEPTH        500
  33. #define ITYPE        double atoi()
  34. #define ICNV(n)        atoi(n)
  35. #define NIL        0
  36. #endif
  37.  
  38. /* for the CPM68K compiler */
  39. #ifdef CPM68K
  40. #define NNODES        1000
  41. #define TDEPTH        500
  42. #define LOCAL
  43. #define AFMT        "%lx"
  44. #define FLONUM        double
  45. #undef NULL
  46. #define NULL        0L
  47. #endif
  48.  
  49. /* for the Atari 520ST (DRI C Compiler) */
  50. #ifdef ATARI
  51. #define NNODES        1000
  52. #define TDEPTH        500
  53. #define LOCAL
  54. #define AFMT        "%lx"
  55. #define FLONUM        double
  56. #undef NULL
  57. #define NULL        0L
  58. #define getc(fp)    stgetc(fp)
  59. #define putc(ch,fp)    stputc(ch,fp)
  60. #endif
  61.  
  62. /* for the DeSmet compiler */
  63. #ifdef DESMET
  64. #define NNODES        1000
  65. #define TDEPTH        500
  66. #define LOCAL
  67. #define getc(fp)    getcx(fp)
  68. #define putc(ch,fp)    putcx(ch,fp)
  69. #define EOF        -1
  70. #endif
  71.  
  72. /* for the MegaMax compiler */
  73. #ifdef MEGAMAX
  74. #define NNODES        1000
  75. #define TDEPTH        500
  76. #define TSTKSIZE    (4 * TDEPTH)
  77. #define LOCAL
  78. #define AFMT        "%lx"
  79. #define getc(fp)    macgetc(fp)
  80. #define putc(ch,fp)    macputc(ch,fp)
  81. #endif
  82.  
  83. /* for the VAX-11 C compiler */
  84. #ifdef vms
  85. #define NNODES        2000
  86. #define TDEPTH        1000
  87. #endif
  88.  
  89. /* for the DECUS C compiler */
  90. #ifdef decus
  91. #define NNODES        200
  92. #define TDEPTH        100
  93. #define FORWARD        extern
  94. #endif
  95.  
  96. /* for unix compilers */
  97. #ifdef unix
  98. #define NNODES        200
  99. #define TDEPTH        100
  100. #endif
  101.  
  102. /* for the AZTEC C compiler (8086) */
  103. #ifdef AZTEC
  104. #define NNODES        1000
  105. #define TDEPTH        500
  106. #define FLONUM        double
  107. #define getc(fp)    agetc(fp)
  108. #define putc(ch,fp)    aputc(ch,fp)
  109. #define NIL        0
  110. #endif
  111.  
  112. /* default important definitions */
  113. #ifndef NNODES
  114. #define NNODES        200
  115. #endif
  116. #ifndef TDEPTH
  117. #define TDEPTH        100
  118. #endif
  119. #ifndef FORWARD
  120. #define FORWARD
  121. #endif
  122. #ifndef LOCAL
  123. #define LOCAL        static
  124. #endif
  125. #ifndef AFMT
  126. #define AFMT        "%x"
  127. #endif
  128. #ifndef FIXNUM
  129. #define FIXNUM        long
  130. #endif
  131. #ifndef ITYPE
  132. #define ITYPE        long atol()
  133. #endif
  134. #ifndef ICNV
  135. #define ICNV(n)        atol(n)
  136. #endif
  137. #ifndef IFMT
  138. #define IFMT        "%ld"
  139. #endif
  140. #ifndef FLONUM
  141. #define FLONUM        float
  142. #endif
  143. #ifndef FTYPE
  144. #define FTYPE        double atof()
  145. #endif
  146. #ifndef FCNV
  147. #define FCNV(n)        atof(n)
  148. #endif
  149. #ifndef FFMT
  150. #define FFMT        "%f"
  151. #endif
  152. #ifndef TSTKSIZE
  153. #define TSTKSIZE    (sizeof(NODE *) * TDEPTH)
  154. #endif
  155.  
  156. /* useful definitions */
  157. #define TRUE    1
  158. #define FALSE    0
  159. #ifndef NIL
  160. #define NIL    (NODE *)0
  161. #endif
  162.  
  163. /* absolute value macros */
  164. #define abs(n)    ((n) < 0 ? -(n) : (n))
  165. #define fabs(n)    ((n) < 0.0 ? -(n) : (n))
  166.  
  167. /* program limits */
  168. #define STRMAX        100        /* maximum length of a string constant */
  169.     
  170. /* node types */
  171. #define FREE    0
  172. #define SUBR    1
  173. #define FSUBR    2
  174. #define LIST    3
  175. #define SYM    4
  176. #define INT    5
  177. #define STR    6
  178. #define OBJ    7
  179. #define FPTR    8
  180. #define FLOAT    9
  181.  
  182. /* node flags */
  183. #define MARK    1
  184. #define LEFT    2
  185.  
  186. /* string types */
  187. #define DYNAMIC    0
  188. #define STATIC    1
  189.  
  190. /* new node access macros */
  191. #define ntype(x)    ((x)->n_type)
  192. #define atom(x)        ((x) == NIL || (x)->n_type != LIST)
  193. #define null(x)        ((x) == NIL)
  194. #define listp(x)    ((x) == NIL || (x)->n_type == LIST)
  195. #define consp(x)    ((x) && (x)->n_type == LIST)
  196. #define subrp(x)    ((x) && (x)->n_type == SUBR)
  197. #define fsubrp(x)    ((x) && (x)->n_type == FSUBR)
  198. #define stringp(x)    ((x) && (x)->n_type == STR)
  199. #define symbolp(x)    ((x) && (x)->n_type == SYM)
  200. #define filep(x)    ((x) && (x)->n_type == FPTR)
  201. #define objectp(x)    ((x) && (x)->n_type == OBJ)
  202. #define fixp(x)        ((x) && (x)->n_type == INT)
  203. #define floatp(x)    ((x) && (x)->n_type == FLOAT)
  204. #define car(x)        ((x)->n_car)
  205. #define cdr(x)        ((x)->n_cdr)
  206. #define rplaca(x,y)    ((x)->n_car = (y))
  207. #define rplacd(x,y)    ((x)->n_cdr = (y))
  208. #define getvalue(x)    ((x)->n_symvalue)
  209. #define setvalue(x,v)    ((x)->n_symvalue = (v))
  210.  
  211. /* symbol node */
  212. #define n_symplist    n_info.n_xsym.xsy_plist
  213. #define n_symvalue    n_info.n_xsym.xsy_value
  214.  
  215. /* subr/fsubr node */
  216. #define n_subr        n_info.n_xsubr.xsu_subr
  217.  
  218. /* list node */
  219. #define n_car        n_info.n_xlist.xl_car
  220. #define n_cdr        n_info.n_xlist.xl_cdr
  221. #define n_ptr        n_info.n_xlist.xl_car
  222.  
  223. /* integer node */
  224. #define n_int        n_info.n_xint.xi_int
  225.  
  226. /* float node */
  227. #define n_float        n_info.n_xfloat.xf_float
  228.  
  229. /* string node */
  230. #define n_str        n_info.n_xstr.xst_str
  231. #define n_strtype    n_info.n_xstr.xst_type
  232.  
  233. /* object node */
  234. #define n_obclass    n_info.n_xobj.xo_obclass
  235. #define n_obdata    n_info.n_xobj.xo_obdata
  236.  
  237. /* file pointer node */
  238. #define n_fp        n_info.n_xfptr.xf_fp
  239. #define n_savech    n_info.n_xfptr.xf_savech
  240.  
  241. /* node structure */
  242. typedef struct node {
  243.     char n_type;        /* type of node */
  244.     char n_flags;        /* flag bits */
  245.     union {            /* value */
  246.     struct xsym {        /* symbol node */
  247.         struct node *xsy_plist;    /* symbol plist - (name . plist) */
  248.         struct node *xsy_value;    /* the current value */
  249.     } n_xsym;
  250.     struct xsubr {        /* subr/fsubr node */
  251.         struct node *(*xsu_subr)();    /* pointer to an internal routine */
  252.     } n_xsubr;
  253.     struct xlist {        /* list node (cons) */
  254.         struct node *xl_car;    /* the car pointer */
  255.         struct node *xl_cdr;    /* the cdr pointer */
  256.     } n_xlist;
  257.     struct xint {        /* integer node */
  258.         FIXNUM xi_int;        /* integer value */
  259.     } n_xint;
  260.     struct xfloat {        /* float node */
  261.         FLONUM xf_float;        /* float value */
  262.     } n_xfloat;
  263.     struct xstr {        /* string node */
  264.         int xst_type;        /* string type */
  265.         char *xst_str;        /* string pointer */
  266.     } n_xstr;
  267.     struct xobj {        /* object node */
  268.         struct node *xo_obclass;    /* class of object */
  269.         struct node *xo_obdata;    /* instance data */
  270.     } n_xobj;
  271.     struct xfptr {        /* file pointer node */
  272.         FILE *xf_fp;        /* the file pointer */
  273.         int xf_savech;        /* lookahead character for input files */
  274.     } n_xfptr;
  275.     } n_info;
  276. } NODE;
  277.  
  278. /* execution context flags */
  279. #define CF_GO        1
  280. #define CF_RETURN    2
  281. #define CF_THROW    4
  282. #define CF_ERROR    8
  283. #define CF_CLEANUP    16
  284. #define CF_CONTINUE    32
  285.  
  286. /* execution context */
  287. typedef struct context {
  288.     int c_flags;            /* context type flags */
  289.     struct node *c_expr;        /* expression (type dependant) */
  290.     jmp_buf c_jmpbuf;            /* longjmp context */
  291.     struct context *c_xlcontext;    /* old value of xlcontext */
  292.     struct node *c_xlstack;        /* old value of xlstack */
  293.     struct node *c_xlenv;        /* old value of xlenv */
  294.     int c_xltrace;            /* old value of xltrace */
  295. } CONTEXT;
  296.  
  297. /* function table entry structure */
  298. struct fdef {
  299.     char *f_name;            /* function name */
  300.     int f_type;                /* function type SUBR/FSUBR */
  301.     struct node *(*f_fcn)();        /* function code */
  302. };
  303.  
  304. /* memory segment structure definition */
  305. struct segment {
  306.     int sg_size;
  307.     struct segment *sg_next;
  308.     struct node sg_nodes[1];
  309. };
  310.  
  311. /* external procedure declarations */
  312. extern struct node *xleval();        /* evaluate an expression */
  313. extern struct node *xlapply();        /* apply a function to arguments */
  314. extern struct node *xlevlist();        /* evaluate a list of arguments */
  315. extern struct node *xlarg();        /* fetch an argument */
  316. extern struct node *xlevarg();        /* fetch and evaluate an argument */
  317. extern struct node *xlmatch();        /* fetch an typed argument */
  318. extern struct node *xlevmatch();    /* fetch and evaluate a typed arg */
  319. extern struct node *xlgetfile();    /* fetch a file/stream argument */
  320. extern struct node *xlsend();        /* send a message to an object */
  321. extern struct node *xlenter();        /* enter a symbol */
  322. extern struct node *xlsenter();        /* enter a symbol with a static pname */
  323. extern struct node *xlmakesym();    /* make an uninterned symbol */
  324. extern struct node *xlsave();        /* generate a stack frame */
  325. extern struct node *xlframe();        /* establish a new environment frame */
  326. extern struct node *xlgetvalue();    /* get value of a symbol (checked) */
  327. extern struct node *xlxgetvalue();    /* get value of a symbol */
  328. extern struct node *xlygetvalue();    /* get value of a symbol (no ivars) */
  329.  
  330. extern struct node *cvfixnum();        /* convert a fixnum */
  331. extern struct node *cvflonum();        /* convert a flonum */
  332.  
  333. extern struct node *xlgetprop();    /* get the value of a property */
  334. extern char *xlsymname();        /* get the print name of a symbol */
  335.  
  336. extern struct node *newnode();        /* allocate a new node */
  337. extern char *stralloc();        /* allocate string space */
  338. extern char *strsave();            /* make a safe copy of a string */
  339. əəəəəəəəəəəəəəəəəəəəə